COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C  SUBRS.  SLUR, (JUGGLE), (LOOP), PLTSRT, (LINES), (HOMER),
C00012 ENDMK
C⊗;
C  SUBRS.  SLUR, (JUGGLE), (LOOP), PLTSRT, (LINES), (HOMER),
C  (PLACE), (FINDIT), SCL, FORMAT

	SUBROUTINE SLUR
	IMPLICIT INTEGER(A-Q,T-Z)
	COMMON/SLR/ SLURX(32)
	REAL CENTR
	COMMON /XRN/RN(1) /PLTR/PLT,RHT,RDIS 
	COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RB,
	1 K,KQ,TWICE,RST7,RX,RXX,RTILT,RC,RZ,RW,J3,J4,
	1 J5,J6,J7,J8,J9,J10,J11,JQ(8),RJ
	COMMON/PTR/PWDS(1) /STF/RSTFAC(0/7),RSTJ2 
	1 /LIMIT/LIMIT,ITEM,L,I,IX /ALF/INP,SLURY(72) 
CF	DATA RZZ/2.8/
C  DEFAULT VALUE OF SLUR CURVE FACTOR IS 2.8	

CCC	IF(JA.NE.12)GO TO 2
CF	RA=5.96*RSTJ2*R5
CF	L=3
CF	J8=J8*RDIS
CF	IF(J7.LE.J6)J7=J7+360
CF	KQ=6
CF	IF(PLT)KQ=1
CF10	DO 3 K=J6,J7,KQ
CF	R=K
CF	CALL LINES(R3+RA*SIND(R),CENTR+RA*COSD(R),L)
CF3	L=2
CF	J8=J8-1
CF	IF(J8)RETURN
CF	RA=RA+1/RDIS
CF	L=3
CF	GO TO 10
CJA=12  DRAWS CIRCLES. P5=RADIUS, P6=DEGR.1, P7=DEGR.2,P8=THICK(EXPANDS
CCC	CALL CIRCLE
CCC	RETURN

C*** SLURS *** 5, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8
C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY
C  P9=NUM IN BRACKET(IF NON-ZERO)
2	J10=1
	J4=-1
	J5=1
C  ↑↑↑↑ FOR DPY ONLY (32 SEGS ARE USED)
	TWICE=-1
	IF(R3.GT.-1000)GO TO 2100
	R=-R3-1000
	L=R
	R=-(R3+1000+R)
	R3=RN(PWDS(L)+4)+R
2100	IF(R6.GT.-1000)GO TO 21  
	R=-R6-1000
	L=R
	R=-(R6+1000+R)
	R6=RN(PWDS(L)+4)+R
COCT	IF(R6)R6=202
C  R6=NEG. IS FOR PAGE-LAYOUT PROG. TELLS WHICH NOTE TO SLUR TO.
21	RST7=RSTJ2*7.
	RJ=ABS(R7)
C R7+100=LEFT HALF SLUR, +200=RIGHT HALF, +300=REVERSE DIRECTION.
	IF(RJ.LT.100)RJ=-1
	R7=AMOD(R7,100.0)
	IF(RJ.LT.300)GO TO 20
	RJ=0
CC*** NOT YET!	R5=R5-(2*R7)
C R5 THINKS THE SLUR ISN'T REVERSED.
C TO USE THIS ADD R6=SQRT((R5-R4)**2+(R6-R3)**2)+R3(WITH FACTORS)
20	RQQ=R5-R4
	IF(R6.GT.1000)CALL RNOTE(R6)
	GO TO (5,6,7),J8+4
	GO TO 4
CC5	R=32
5	R=30
C AFTER DOTTED NOTE
	GO TO 8
CC6	R=22
6	R=18
C BETWEEN NOTES
CC8	RX=-1.3
8	RX=-0.75
	GO TO 9
7	R=7
	RX=RSTJ2
9	CALL RJBX(R)
	R6=R6+RX
4	RXX=RHORZ(R6)-R3
	RTILT=RQQ*RST7
80	RX=SQRT(RXX**2+RTILT**2)
	IF(J8.NE.-1)GO TO 1
	IF(RQQ.GT.8)RQQ=8
	IF(RQQ.LT.-8)RQQ=-8
	RQQ=RQQ*RSTFAC(J2)*1.0
	IF(R7)RQQ=-RQQ
	R3=R3-RQQ
C  MOVES STEEP SLUR LEFT OR RIGHT IF P8=-1
1	R=CENTR
	IF(J8.GT.0)GO TO 180
C  JUMP FOR BRACKETS
	L=32
	CALL SLOOP

CF	RB=RX/71.
CF	DO 81 K=0,71
CF81	SLURX(K+1)=RB*(K)+R3
CF	RA=R7*RST7
CF41	IF(R9.EQ.0)R9=RZZ
CF	R=R+RA
CF	L=0
CF	DO 40 K=36,1,-1
CF	L=L+1
CF	RW=R-RA*(K/36.)**R9
CF	SLURY(L)=RW
CF40	SLURY(73-L)=RW
CF	L=72

CF89	IF(RTILT.EQ.0)GO TO 87
CF	RW=ATAN2(RTILT,RXX)
CF	RA=SIN(RW)
CF	RB=COS(RW)
CF	RZ=SLURX(1)
CF	RW=SLURY(1)
CF	DO 83 K=1,L
CF	R=SLURX(K)-RZ
CF	RXX=SLURY(K)-RW
CF	SLURX(K)=RB*R-RA*RXX+RZ
CF83	SLURY(K)=RB*RXX+RA*R+RW

87	IF(J4)CALL LINES(SLURX(J10),SLURY(J10),3)
	J6=J10
	J7=L
	IF(J4.NE.0)GO TO 22
	CALL EXCH(J6,J7)
	J5=-1
22	DO 88 K=J6,J7,J5
88	CALL LINES(SLURX(K),SLURY(K),2)
	IF(J5.GT.1)CALL LINES(SLURX(L),SLURY(L),2)
C  DISPLAY END POINT OF SLUR
	IF(TWICE)RETURN
	TWICE=TWICE-1
	GO TO 182
180	RW=R+R7*RST7
	TWICE=-1
CC	KQ=1
	J5=1
	RX=RX+R3
CC	RA=(R5-R4)*RST7
	IF(J9.EQ.0)GO TO 181
	RZ=RTILT/(RX-R3)
	TWICE=2
CC	RZ=RX-R3
	RXX=RX
	RWID=(R3+RXX)/2.
182	IF(TWICE.EQ.1)GO TO 183
C  DOES LEFT SIDE FIRST.
	IF(TWICE.EQ.0)GO TO 184
C LAST IS NUMBER.
	J8=2
	RC=RSTJ2*13.
	RX=RWID-RC
	RWW=RTILT
185	RTILT=RZ*(RX-R3)

C  PUT IN FUNC. HERE FOR THIS SLOPE AND FOR PART. BEAMS.

	GO TO 181
183	J8=3
	RX=RXX
	RTILT=RWW
	RXX=R3
	R3=RWID+RC
	RXX=RZ*(R3-RXX)
	R=R+RXX
	RW=RW+RXX
	GO TO 185

181	SLURX(1)=R3
	SLURY(1)=R
	SLURX(2)=R3
	SLURY(2)=RW
	SLURX(3)=RX
	SLURY(3)=RW+RTILT
	SLURX(4)=RX
	SLURY(4)=R+RTILT
	L=4
	IF(J8.EQ.2)L=3
	IF(J8.EQ.3)J10=2
CC	TWICE=-1
	GO TO 87
184	J3=RWID
C  PUT IN VERT. POS. WHEN SLOPE!
	R4=RQQ/2.+R4+R7-1.
	R6=1.
C  R7=1 IS FOR ITALICS
	R7=1
C  OR USE 1 FOR ITALIC NUMBERS.
	R8=0
	CALL MAKNUM(R9)
	END

C********  JUGGLER  ********
	SUBROUTINE SCL
C  SETS UP SCALING MARKERS.
	COMMON /STF/RSTFAC(0/7),RSTJ2 /RINP/SU(900)
	COMMON R2,JA,CT,J2,R3,R4,R5,RJQ(17),J3,J4,J5,J6,J(16)
	1 /POSI/STFF(0/7),J102,POS
	J2=R2
	IF(J2.NE.99)GO TO 1008
	CALL HYDPOG(2)
	RETURN
1008	J5=0
	J6=0
	RSTJ2=RSTFAC(J2)
C  SETS UP SCALE LINES.
	J4=200
	IF(R3.NE.0)J4=400
C  PUTS SCALE TO 400
	R2=STFF(J2)+60.*RSTJ2
	RJ=R2+60.
	CALL DPYSET(2,SU,700)
	CALL DPYBRT(1)
	POS=RJ+40.
	RSTJ2=1.
	DO 1002 MX=10,J4,10
	RA=RHORZ(FLOAT(MX))
	R3=RA-58
	IF(MX.GT.10)CALL PNUM
CC1005	IF(R5.NE.0)GO TO 1007
C  JUMP FOR STAFF NUMBERS
	CALL LINX(RA,R2,RA,RJ)
	J5=J5+1
1002	IF(J5.EQ.10)J5=0
	CALL LINES(-596.0,RJ,2)
	CALL LINES(-596.0,R2,2)
	R6=1.5
C  NEXT SETS UP STAFF NUMBERS
	R3=-620.
	DO 1007 K=0,7 
	POS=STFF(K)+40.
	J5=IABS(K)
	CALL PNUM
1007	CONTINUE
	CALL DPYOUT(2)
	CALL SETPOG(1)
	END

	SUBROUTINE NAMEXT(JA,NAME,IEXT)
	DIMENSION JA(1),A(5),FM(7)
	DATA A/'A1','A2','A3','A4','A5'/,FM(1)/'('/
	EQUIVALENCE (A5,A(5)),(FM2,FM(2)),(FM3,FM(3)),(FM4,FM(4)),
	1 (FM5,FM(5)),(FM6,FM(6)),(FM7,FM(7)),(A3,A(3))
	DO 9 K=2,7
9	FM(K)=' '
	ID=0
	IA=0
	NAME=' '
	DO 1 K=20,1,-1
	IF(JA(K).EQ.' ')GO TO 1
5	DO 2 L=K-1,1,-1
	J=JA(L)
	IF(J.NE.' ')GO TO 3
	IA=L
	GO TO 4
3	IF(J.NE.'.')GO TO 2
	ID=L
	K=L
C '.' ASSUMES THERE IS AN EXTENSION 
	GO TO 5
2	CONTINUE
	GO TO 4
1	CONTINUE
C ALL BLANK IF WE GET HERE
	RETURN
4	IF(IA.NE.0)GO TO 6
	IF(JA(1).EQ.-1)RETURN
C  ↑↑↑ FOR 'RS', 'SA', 'G', ETC. WITH NO NAME FOLLOWING.
	IF(ID.NE.0)GO TO 7
C NOW ONLY A NAME IS ON THIS LINE
	FM2=A5
	FM3=')'
	REREAD FM,NAME
	RETURN
7	FM3=',A1,'
	FM2=A(ID-1)
	FM4=A3
	FM5=')'
C  FOUND NAME AND EXTENSION
	REREAD FM, NAME,K,IEXT
	RETURN
6	IF(IA.GT.5)RETURN
C .GT.5 = TOO MUCH IN FRONT OF NAME!!
	FM2=A(IA)
	FM3=','
	IF(ID.NE.0)GO TO 8
	FM4=A5
	FM5=')'
C  FOUND  'WORD', NAME    WORD= SA, RS, GM, ETC.
	REREAD FM,K,NAME
	RETURN
8	FM4=A(ID-IA-1)
	FM5=',A1,'
	FM6=A3
	FM7=')'
	REREAD FM,K,NAME,K,IEXT
	END